perm filename SPOT[1,DBL] blob
sn#057147 filedate 1973-09-14 generic text, type T, neo UTF8
00100 (DE SPOT ()
00200 (PROG () ~Call this function to run program
00300 (INITIALIZE)
00400 (ACCEPT_DESCRIPTION)
00500 (RETURN NIL)
00600 )
00700 )
00800 (DE CHECK_FOR_NAME ()
00900 (COND ~Here we check to see if the scene read in has a name
01000 ((NULL (CAR SCENE))(GUESS_OBJECT OBJECT_LIST))
01100 (T (CHECK_FOR_OLD_NAME))
01200 )
01300 )
01400 (DE CHECK_FOR_OLD_NAME ()
01500 (COND ~Is SCENE already named in OBJECT_LIST?
01600 ((CHECK_OBLIST OBJECT_LIST) (PATCH_OLD_DESCRIPTION))
01700 (T (NEW_NAME))
01800 )
01900 )
02000 (DE CHECK_OBLIST (LIST)
02100 (COND ~Attempt to find the name of SCENE on OBJECT_LIST
02200 ((NULL LIST) NIL)
02300 ((EQUAL (CAR SCENE) (CAAR LIST)) T)
02400 (T (CHECK_OBLIST (CDR LIST)))
02500 )
02600 )
02700 (DE INITIALIZE ()
02720 (PROG ()
02740 (SETQ OBJECT_LIST NIL)
02760 )
02800 )
02900 (DE ACCEPT_DESCRIPTION ()
03000 (PROG () ~Main program loop
03100 (PRINT @READY)
03200 (SETQ SCENE (READ1)) ~Get new SCENE
03300 (CHECK_FOR_NAME) ~This is the first in a chain of functions
03400 ~which process SCENE
03500 (PRINT @(SPOT KNOWS))
03600 (SPRINT OBJECT_LIST 1)
03700 (ACCEPT_DESCRIPTION)
03800 (RETURN NIL)
03900 )
04000 )
04100 (DE PLACE_DATA (SCENE)
04200 (COND ~Put facts stated in SCENE into DESCRIPTION
04300 ((NULL SCENE) NIL)
04400 (T
04500 (PROG ()
04600 (INSERT_ITEM (CAAR SCENE) (CDAR SCENE) (CDR DESCRIPTION))
04700 (PLACE_DATA (CDR SCENE))
04800 (RETURN NIL)
04900 )
05000 )
05100 )
05200 )
05300 (DE REPLACE_NAMES (NAME_LIST SCENE DESCRIPTION)
05400 (COND ~Replace the names in SCENE so that they correspond
05500 ~to the names in DESCRIPTION
05600 ((NULL SCENE) NIL)
05700 (T
05800 (SWITCH_NAME NAME_LIST (CAR SCENE) DESCRIPTION)
05900 (REPLACE_NAMES NAME_LIST (CDR SCENE) DESCRIPTION)
06000 )
06100 )
06200 )
06300 (DE SWITCH_NAME (NAME_LIST ITEMS DESCRIPT)
06400 (COND
06500 ((NULL ITEMS) NIL)
06600 (T
06700 (SWITCH_NAME1 NAME_LIST ITEMS DESCRIPT)
06800 (SWITCH_NAME NAME_LIST (CDR ITEMS) DESCRIPT)
06900 )
07000 )
07100 )
07200 (DE SWITCH_NAME1 (NAME_LIST ITEMS DESCRIPT)
07300 (COND
07400 ((NULL NAME_LIST) NIL)
07500 ((AND (EQ (CAR NAME_LIST) (CAR ITEMS)) (NOT (NULL DESCRIPT)))
07600 (RPLACA ITEMS (CAAR DESCRIPT))
07700 )
07800 (T (SWITCH_NAME1 (CDR NAME_LIST) ITEMS (CDR DESCRIPT)))
07900 )
08000 )
08100 (DE INSERT_ITEM (HEAD ITEM DESCRIPTION)
08200 (COND ~Put an individual fact from SCENE into DESCRIPTION
08300 ((NULL DESCRIPTION) NIL)
08400 ((EQUAL HEAD (CAAR DESCRIPTION))
08500 (COND
08600 ((NULL (CDAR DESCRIPTION)) (RPLACD (CAR DESCRIPTION)
08700 (LIST (CONS ITEM @(CAN)))))
08800 (T (FIND_OR_PLACE HEAD ITEM (CDAR DESCRIPTION)))
08900 )
09000 )
09100 (T (INSERT_ITEM HEAD ITEM (CDR DESCRIPTION)))
09200 )
09300 )
09400 (DE SAME_THING1 (DESCRIPT)
09500 (PROG () ~GUESS_OBJECT wants to know if SCENE is the same
09600 ~thing as DESCRIPT
09700 (REPLACE_NAMES (CADR SCENE) (CDDR SCENE) DESCRIPT)
09800 (RETURN (SAME_THING DESCRIPT))
09900 )
10000 )
10100 (DE SAME_THING (DESCRIPT)
10200 (COND ~Check MUSTs and MUSNTs in DESCRIPT for a conflict
10300 ~with SCENE
10400 ((NULL DESCRIPT) T)
10500 ((AND (ST_MUST (CAAR DESCRIPT) (CDAR DESCRIPT))
10600 (ST_MUSNT (CAAR DESCRIPT) (CDAR DESCRIPT))
10700 )
10800 (SAME_THING (CDR DESCRIPT))
10900 )
11000 (T NIL)
11100 )
11200 )
11300 (DE ST_MUST (HEAD DESCRIPT)
11400 (COND ~Check for a MUST condition in DESCRIPT which isn't
11500 ~in SCENE
11600 ((NULL DESCRIPT) T)
11700 ((EQUAL (CDAR DESCRIPT) @(MUST))
11800 (COND
11900 ((NOT (MEMBER (CONS HEAD (CAAR DESCRIPT)) SCENE)) NIL)
12000 (T (ST_MUST HEAD (CDR DESCRIPT)))
12100 )
12200 )
12300 (T (ST_MUST HEAD (CDR DESCRIPT)))
12400 )
12500 )
12600 (DE ST_MUSNT (HEAD DESCRIPT)
12700 (COND ~Check for a MUSNT condition which is in SCENE
12800 ((NULL DESCRIPT) T)
12900 ((EQUAL (CDAR DESCRIPT) @(MUSNT))
13000 (COND
13100 ((MEMBER (CONS HEAD (CAAR DESCRIPT)) SCENE) NIL)
13200 (T (ST_MUSNT HEAD (CDR DESCRIPT)))
13300 )
13400 )
13500 (T (ST_MUSNT HEAD (CDR DESCRIPT)))
13600 )
13700 )
13800 (DE FIND_OR_PLACE (HEAD ITEM LIST1)
13900 (COND ~Put a fact in DESCRIPTION if the fact isn't
14000 ~already there or is accompanied by a MUSNT
14100 ((EQUAL ITEM (CAAR LIST1))
14200 (COND ~Change MUSNT to CAN
14300 ((EQUAL (CDAR LIST1) @(MUSNT)) (RPLACD (CAR LIST1) @(CAN)))
14400 )
14500 )
14600 (T
14700 (COND ~LIST1 is exhausted, so the fact isn't on
14800 ~LIST1. Put it there.
14900 ((NULL (CDR LIST1)) (RPLACD LIST1 (LIST (CONS ITEM @(CAN)))))
15000 (T (FIND_OR_PLACE HEAD ITEM (CDR LIST1)))
15100 )
15200 )
15300 )
15400 )
15500 (DE CREATE_DESCRIPTION ()
15600 (PROG () ~Create a description for a scene which
15700 ~wasn't previously defined
15800 (SETQ DESCRIPTION (CONS (CAR SCENE) (EXPAND (CADR SCENE))))
15900 (PLACE_DATA (CDDR SCENE))
16000 (RETURN DESCRIPTION)
16100 )
16200 )
16300 (DE FIX_MUSTS (SCENE1 DESCRIPT)
16400 (COND ~PATCH_OLD_DESCRIPTION wants to see incorrect
16500 ~MUSTs replaced by CANs
16600 ((NULL DESCRIPT) NIL)
16700 (T (FM1 SCENE1 (CAAR DESCRIPT) (CDAR DESCRIPT))
16800 (FIX_MUSTS SCENE1 (CDR DESCRIPT))
16900 )
17000 )
17100 )
17200 (DE FM1 (SCENE2 HEAD DESCRIPT)
17300 (COND
17400 ((NULL DESCRIPT) NIL)
17500 ((EQUAL (CDAR DESCRIPT) @(MUST))
17600 (COND
17700 ((NOT (MEMBER (CONS HEAD (CAAR DESCRIPT)) SCENE2))
17800 (RPLACD (CAR DESCRIPT) @(CAN))
17900 )
18000 )
18100 (FM1 SCENE2 HEAD (CDR DESCRIPT))
18200 )
18300 (T (FM1 SCENE2 HEAD (CDR DESCRIPT)))
18400 )
18500 )
18600 (DE EXPAND (L)
18700 (COND
18800 ((NULL L) NIL)
18900 (T (CONS (LIST (CAR L)) (EXPAND (CDR L))))
19000 )
19100 )
19200 (DE NEW_NAME ()
19300 (SETQ OBJECT_LIST (CONS (CREATE_DESCRIPTION) OBJECT_LIST))
19400 )
19500 (DE PATCH_OLD_DESCRIPTION ()
19600 (PROG () ~A description is already defined in OBJECT_LIST.
19700 ~Put in more of the nature of the description.
19800 (SETQ DESCRIPTION (MATCH (CAR SCENE) OBJECT_LIST))
19900 (REPLACE_NAMES (CADR SCENE) (CDDR SCENE) (CDR DESCRIPTION))
20000 (PLACE_DATA (CDDR SCENE))
20100 (FIX_MUSTS (CDDR SCENE) (CDR DESCRIPTION))
20200 (REINSERT DESCRIPTION OBJECT_LIST)
20300 (RETURN NIL)
20400 )
20500 )
20600 (DE REINSERT (DESCRIPTION OBJECT_LIST)
20700 (COND ~Put the new description of an object in OBJECT_LIST
20800 ((EQ (CAR DESCRIPTION) (CAAR OBJECT_LIST))
20900 (RPLACD (CAR OBJECT_LIST) (CDR DESCRIPTION))
21000 )
21100 (T (REINSERT DESCRIPTION (CDR OBJECT_LIST)))
21200 )
21300 )
21400 (DE MATCH (NAME LIST)
21500 (COND ~Find the description in OBJECT_LIST which
21600 ~corresponds to name
21700 ((EQ NAME (CAAR LIST)) (CAR LIST))
21800 (T (MATCH NAME (CDR LIST)))
21900 )
22000 )
22100 (DE GUESS_OBJECT (LIST)
22200 (COND ~Decide if SCENE is something already defined in
22300 ~OBJECT_LIST
22400 ((NULL LIST) (NO_GUESS))
22500 ((SAME_THING1 (CDAR LIST)) (GUESS_THIS (CAR LIST)))
22600 (T (GUESS_OBJECT (CDR LIST)))
22700 )
22800 )
22900 (DE NO_GUESS ()
23000 (PROG ()
23100 (PRINT @(SPOT: I DONT KNOW WHAT IT IS, WHAT IS IT?))
23200 (SETQ SCENE (APPEND (READ1) (CDR SCENE)))
23300 (COND ((NOT (NULL (CAR SCENE))) (CHECK_FOR_OLD_NAME)))
23400 (RETURN NIL)
23500 )
23600 )
23700 (DE GUESS_THIS (OBJECT)
23800 (PROG ()
23900 (PRINT @(SPOT: I BELIEVE THIS IS A))
24000 (PRINT (CAR OBJECT))
24100 (PRINT @(WHAT IS IT))
24200 (SETQ SCENE (APPEND (READ1) (CDR SCENE)))
24300 (COND
24400 ((NOT (EQ (CAR SCENE) (CAR OBJECT)))
24500 (COND ((NOT (NULL (CAR SCENE))) (CHECK_FOR_OLD_NAME)))
24600 (TIGHTEN_CONSTRAINTS (CDR SCENE) (CDR OBJECT))
24700 )
24800 (T (PATCH_OLD_DESCRIPTION))
24900 )
25000 (RETURN NIL)
25100 )
25200 )
25300 (DE TIGHTEN_CONSTRAINTS (SCENE1 OBJECT)
25400 (PROG () ~A scene was thought to be something which it
25500 ~isn't. Insert a MUST or a MUSNT in the description.
25600 (REPLACE_NAMES (CAR SCENE1) (CDR SCENE1) OBJECT)
25700 (COND
25800 ((INSERT_MUSNT (CDR SCENE1) OBJECT))
25900 ((INSERT_MUST1 (CDR SCENE1) OBJECT))
26000 (T (PRINT @(I CANT FIGURE OUT WHAT'S WRONG)))
26100 )
26200 )
26300 )
26400 (DE INSERT_MUSNT (SCENE1 OBJECT)
26500 (COND
26600 ((NULL SCENE1) NIL)
26700 ((INSERT_MUSNT1 (CAR SCENE1) OBJECT) T)
26800 (T (INSERT_MUSNT (CDR SCENE1) OBJECT))
26900 )
27000 )
27100 (DE NOT_PART_OF (ITEM HEAD DESCRIPT)
27200 (COND
27300 ((NULL DESCRIPT) T)
27400 ((EQUAL ITEM (CONS HEAD (CAAR DESCRIPT))) NIL)
27500 (T (NOT_PART_OF ITEM HEAD (CDR DESCRIPT)))
27600 )
27700 )
27800 (DE INSERT_MUST (SCENE HEAD DESCRIPT)
27900 (COND
28000 ((NULL DESCRIPT) NIL)
28100 ((AND (EQUAL (CDAR DESCRIPT) @(CAN))
28200 (NOT (MEMBER (CONS HEAD (CAAR DESCRIPT)) SCENE)))
28300 (RPLACD (CAR DESCRIPT) @(MUST))
28400 )
28500 (T (INSERT_MUST SCENE HEAD (CDR DESCRIPT)))
28600 )
28700 )
28800 (DE INSERT_MUSNT1 (ITEM OBJECT)
28900 (COND
29000 ((NULL OBJECT) NIL)
29100 ((AND (EQ (CAR ITEM) (CAAR OBJECT))
29200 (NOT_PART_OF ITEM (CAAR OBJECT) (CDAR OBJECT)))
29300 (RPLACD (CAR OBJECT) (CONS (CONS (CDR ITEM) @(MUSNT))
29400 (CDAR OBJECT))) T)
29500 (T (INSERT_MUSNT1 ITEM (CDR OBJECT)))
29600 )
29700 )
29800 (DE INSERT_MUST1 (SCENE OBJECT)
29900 (COND
30000 ((NULL OBJECT) NIL)
30100 ((INSERT_MUST SCENE (CAAR OBJECT) (CDAR OBJECT)) T)
30200 (T (INSERT_MUST1 SCENE (CDR OBJECT)))
30300 )
30400 )
30500 (DE READ1 ()
30600 (PROG (IN)
30700 (SETQ IN (READ))
30800 (PRINT @TEACHER:)
30900 (PRIN1 IN)
31000 (RETURN IN)
31100 )
31200 )